home *** CD-ROM | disk | FTP | other *** search
/ Amiga Collections: Purity / Purity #48 (1995-06-25)(PackMAN)(DE)[WB].zip / Purity #48 (1995-06-25)(PackMAN)(DE)[WB].adf / Apfel / Apfel.p < prev    next >
Text File  |  1995-06-23  |  2KB  |  97 lines
  1. PROGRAM Apfel2D;
  2.  
  3. (* This great program creates 2D Apfelmännchen on your screen 
  4.    It is not very fast, but easy to understand. If you want to contact
  5.    me: Daniel Amor <daniel.amor@student.uni-tuebingen.de>. Play around
  6.    with the constants to create another picture! *)
  7.  
  8. USES Graphics, Intuition;
  9.  
  10. CONST ru=-2;    (* Gauss-Parameter *)
  11.       ro=0.5;   (* Gauss-Parameter *)
  12.       iu=-1.25; (* Gauss-Parameter *)  
  13.       io=1.25;  (* Gauss-Parameter *)
  14.       nm=100;   (* max Iteration *)
  15.       xr=0.1;   (* X *)
  16.       yi=0.5;   (* Y *)
  17.       xm=639;   (* x-zoom factor *) 
  18.       ym=199;   (* y-zoom factor *)
  19.       ax=639;   (* X-dimension, depending on your window *) 
  20.       ay=199;   (* Y-dimension, depending on your window *) 
  21.      
  22. VAR x,y,r,i,d,a,b,da,db : REAL;
  23.     win                 : p_Window;
  24.     msg                        : p_IntuiMessage;
  25.     loop                : BOOLEAN;
  26.     U,v,n               : INTEGER
  27.     ok                  : LONGINT;
  28.  
  29. FUNCTION md(x: INTEGER): INTEGER;
  30.  
  31. BEGIN
  32.   md:=x-TRUNC(x/3)*3;
  33. END;
  34.  
  35. BEGIN
  36.   win:=Open_Window(0,0,640,200,1,_CLOSEWINDOW,WINDOWDEPTH OR WINDOWDRAG OR ACTIVATE OR WINDOWCLOSE,"Mini-Apfel 2D",NIL,0,0,0,0);
  37.  
  38.   (* it's so easy to open a window *)
  39.  
  40.   da:=(ro-ru)/xm;
  41.   db:=(io-iu)/ym;
  42.   b:=iu-db
  43.   FOR U:=11 TO ay-4 DO
  44.   BEGIN
  45.     b:=b+db;
  46.     a:=ru-da;
  47.     FOR v:=4 TO ax-4 DO
  48.     BEGIN
  49.       a:=a+da;
  50.       n:=0;
  51.       r:=xr;
  52.       i:=yi;
  53.       d:=0;
  54.       loop:=FALSE;
  55.       REPEAT      
  56.         IF d<4 THEN 
  57.         BEGIN
  58.           x:=r;
  59.           y:=i;
  60.           r:=x*x-y*y+a;
  61.           i:=2*x*y+b;
  62.           d:=r*r+i*i;
  63.           INC(N);
  64.           IF n=nm THEN loop:=TRUE;
  65.         END
  66.         ELSE 
  67.         BEGIN 
  68.           loop:=TRUE;
  69.         END;
  70.       UNTIL loop
  71.       IF n=nm THEN 
  72.       BEGIN
  73.         SetAPen(Win^.RPort,1); 
  74.         ok:=WritePixel(Win^.RPort,v,U);
  75.       END
  76.       ELSE
  77.       BEGIN
  78.         SetAPen(Win^.RPort,md(n)+1);
  79.         ok:=WritePixel(Win^.RPort,v,U);
  80.       END;
  81.     END;
  82.   END;
  83.  
  84.   (* This is the main Apfelmaennchen-Routine *)
  85.  
  86.   Msg:=NIL;
  87.   REPEAT
  88.     IF Msg<>NIL THEN Reply_Msg(Msg);
  89.     Msg:=Wait_Port(Win^.UserPort);
  90.     Msg:=Get_Msg(Win^.UserPort);
  91.   UNTIL Msg^.Class = _CLOSEWINDOW;
  92.  
  93.   (* Waits until you press the Close-Gadget *)
  94.  
  95. END.        
  96.  
  97.